home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Plus Special 25
/
AMIGAplus Sonderheft 25 (2000)(Falke)(DE)(Track 1 of 4)[!].iso
/
PublicDomain
/
Spiele
/
Solitarexx
/
Scripts
/
Spider.srx
< prev
next >
Wrap
Text File
|
1997-11-22
|
3KB
|
162 lines
/******************************\
** Spider v1.0 for Solitarexx **
** by Michal Szafranski **
\******************************/
OPTIONS RESULTS
tex = 'Spider'
wintex = '"We Have a Winner"'
ADDBUTTON 0 10 "Start"
ADDCYCLE 1 6 '0|1|2|3|4|5|6' 2 'Reshuffles' 12
ADDTEXT 4 24 tex 6
ADDBUTTON 12 10 "Abort"
ADDBUTTON 13 15 "Reshuffle"
ADDTEXT 14 27 tex 6
SELECTGUI 1
SCREENSIZE 4 14 6 0
NEWSTACK 3 8+2 0 0 1 0 7 9
stack.0 = RESULT
NEWSTACK 3 8+0 0 0 2 0 7 9
stack.11 = RESULT
bst. = 0
DO i = 0 TO 3
k = i+1
j = -i+10
b = i+4
NEWSTACK 3 8+2 0 i+1 0 0 7 7
stack.k = RESULT
NEWSTACK 3 8 0 i+1 3 0 7 7
stack.j = RESULT
NEWSTACK 1 8 0 i+1 1 0 7
base.i = RESULT
NEWSTACK 1 8 0 i+1 2 0 7
base.b = RESULT
bst.k = base.i
bst.j = base.b
END
NEWSTACK 3 8+2 0 5 1 0 7 9
stack.5 = RESULT
NEWSTACK 3 8+0 0 5 2 0 7 9
stack.6 = RESULT
NEWSTACK 0 128
deck = RESULT
ADDCARDS deck
ADDCARDS deck SHUFFLED
DO FOREVER
ACTION
PARSE VAR RESULT act rest
IF act = 1 THEN EXIT
IF act = 3 THEN CALL GAME
END
GAME:
CLEANUP deck
SETGADGET 14 STR tex
SELECTGUI 4
kbase. = -2
DO i=0 TO 3
kbase.12.i = -1
kbase.0.i = -1
END
b = 0
s = 0
fin = 0
seq.= 0
DO FOR 104
CARDSELECT deck 1
PARSE VAR RESULT k war .
IF kbase.war.k = -1 THEN DO
base = base.b
MOVECARDS deck base REVERSE
kbase.war.k = base
seq.base = 1-2*(war>0)
b = b+1
END
ELSE CALL DOCYCLE
END
sel = 0
GETGADGET 1
res = RESULT
DO FOREVER
ACTION
PARSE VAR RESULT act stack sid card
SELECT
WHEN act = 1 THEN EXIT
WHEN act = 2 & sel = 0 & card>0 & sid=3 THEN sel = stack
WHEN act = 2 & sel > 0 & (sid = 1 | sel = stack) THEN CALL DOBASE
WHEN act = 2 & sel > 0 & sid = 3 THEN CALL DOSTACKS
WHEN act = 3 & stack = 13 & res>0 THEN CALL DORES
WHEN act = 3 & stack = 12 THEN DO
SELECTGUI 1
RETURN
END
OTHERWISE ERRBEEP
END
END
RETURN
DOSTACKS:
CARDSELECT sel 0 RELATIVE
PARSE VAR RESULT k1 w1 .
CARDSELECT stack 1
PARSE VAR RESULT k2 w2 .
IF k2 = '' THEN DO
w = (w1=0|w1=12)
k2 = k1
END
ELSE w = ABS(w1-w2)
IF w=1 & k1 = k2 THEN MOVECARDS sel stack
ELSE ERRBEEP
sel = 0
RETURN
DORES:
res = res-1
DO i = 0 TO 11
CARDSELECT stack.i 33
MOVECARDS stack.i deck REVERSE
END
s = 0
DO FOR 96-fin
CARDSELECT deck 1
PARSE VAR RESULT k war .
CALL DOCYCLE
END
sel = 0
RETURN
DOCYCLE:
MOVECARDS deck stack.s REVERSE
stack = bst.s
IF stack > 0 & seq.stack~=0 THEN DO
sel = stack.s
CALL CHBASE
IF ok=0 THEN DO
fin = fin +1
MOVECARDS sel stack
END
END
s = (s+1)//12
RETURN
DOBASE:
IF sel~=stack THEN CALL CHBASE
ELSE DO i= 0 TO 7 UNTIL ok=0
stack = base.i
CALL CHBASE
END
IF ok=0 THEN DO
fin = fin +1
MOVECARDS sel stack
IF fin = 96 THEN SETGADGET 14 STR wintex
END
ELSE ERRBEEP
sel = 0
RETURN
CHBASE:
CARDSELECT sel 1
PARSE VAR RESULT k1 w1 .
CARDSELECT stack 1
PARSE VAR RESULT k2 w2 .
IF k1 = k2 & (w1 - w2) = seq.stack THEN ok = 0
ELSE ok = 1
RETURN